home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / mpfeel.lha / MPFeel / Plurals / eubang.c < prev    next >
C/C++ Source or Header  |  1992-07-15  |  57KB  |  1,933 lines
  1. /*
  2.  *    Plurals - A SIMD extension to Eulisp
  3.  *
  4.  *    Author:    S.C.Merrall
  5.  *
  6.  *    File:    eubang.c
  7.  *
  8.  *    Contents:    
  9.  *
  10.  *    Description:    Plurals are objects allocated from a processor array
  11.  *            They are like vectors where each element is on a
  12.  *            seperate processor.
  13.  *
  14.  *    Change History:
  15.  *
  16.  *    Date   Name Comment
  17.  *    -------- ---- -------
  18.  *    16:05:91 SCM  Created
  19.  *    27:01:92 SCM  Added support for symbols
  20.  *    26:03:92 SCM  Removed cm-identify, replaced by cm_put and cm_start
  21.  *    09:04:92 SCM  Added functions for handling temporary pluralspace in lisp
  22.  *    07:06:92 SCM  Added xnet move stuff
  23.  *
  24.  */
  25.  
  26. #include <stdio.h>
  27. #include "defs.h"
  28. #include "structs.h"
  29. #include "funcalls.h"
  30. #include "global.h"
  31. #include "error.h"
  32. #include "allocate.h"
  33. #include "modboot.h"
  34.  
  35. #include "vectors.h"         /* To be able to use vectors macros   */
  36.  
  37. #define ARG_4(stack) (*(stack+4))
  38.  
  39. #ifdef __STDC__
  40.  
  41. #define EUFUN_5(name, a1, a2, a3, a4, a5) \
  42.   LispObject name (LispObject *stackbase) \
  43.     { \
  44.       LispObject a1; \
  45.       LispObject a2; \
  46.       LispObject a3; \
  47.       LispObject a4; \
  48.       LispObject a5; \
  49.       LispObject *stacktop = stackbase+5; \
  50.    /*toplabel:*/ \
  51.       a1 = ARG_0(stackbase); \
  52.       a2 = ARG_1(stackbase); \
  53.       a3 = ARG_2(stackbase); \
  54.       a4 = ARG_3(stackbase); \
  55.       a5 = ARG_4(stackbase);
  56.  
  57. #else
  58.  
  59. #define EUFUN_5(name, a1, a2, a3, a4, a5 ) \
  60.  LispObject name (stackbase)    \
  61.    LispObject *stackbase; \
  62.     { \
  63.       LispObject a1; \
  64.       LispObject a2; \
  65.       LispObject a3; \
  66.       LispObject a4; \
  67.       LispObject a5; \
  68.       LispObject *stacktop = stackbase+5; \
  69.    /*toplabel:*/ \
  70.       a1 = ARG_0(stackbase); \
  71.       a2 = ARG_1(stackbase); \
  72.       a3 = ARG_2(stackbase); \
  73.       a4 = ARG_3(stackbase); \
  74.       a5 = ARG_4(stackbase); 
  75.  
  76. #endif
  77.  
  78.  
  79.  
  80. #include "table.h"        /*  We use a table to keep track of symbols
  81.                  *  referenced by the front end
  82.                  */
  83. extern FILE* current_output;
  84. extern LispObject ListOfStrangeThings;
  85.  
  86. #include "mp_eubang.h"
  87.  
  88. int call_request_value;
  89. int fe_mp_error;
  90.  
  91. #define DBG_CALL(name) char *dbg_fname=name
  92.  
  93. #define CallRequest(alist) (((call_request_value=callRequest alist)==FAIL) ? (copyIn((char *) &mp_error,(char *) &fe_mp_error, sizeof(int)),(int)CallError(stacktop,dbg_fname,allocate_integer(stacktop,fe_mp_error),NONCONTINUABLE)) : call_request_value)
  94.  
  95. #ifdef XLIGHTS
  96.  
  97. extern void visualise();
  98.  
  99. #endif
  100.  
  101. /*char fe_scratch[MASPAR_CONFIG][SCRATCH_MEMORY_SIZE];  Communication scratch
  102.                               * space, total area
  103.                               * equal on both ends.
  104.                               */
  105.  
  106. int maspar_config;
  107. char *fe_scratch;
  108. int   fe_data_length; /* for decode and encode */
  109.      
  110.  
  111. char *pe_scratch;  /*  This is the address of the communicatiuon scratch
  112.             *  space on the back end. Initialised by mp_init in
  113.             *  INIT_plural.
  114.             */
  115.  
  116. LispObject reffed_symbols;      /* Which symbols have been reffed?    */
  117. LispObject fe_symbol_table;     /* Table of fe symbols refenced by be */
  118. int        next_symbol_key;    /* key fe_symbols are stored under    */
  119.  
  120. #define allocate_mp_context(address)  \
  121.       ({int __xxx=address; \
  122.       allocate_integer(stacktop,(int) __xxx); })
  123.  
  124. #define mp_context_address(LObj) ((char *) (intval(LObj)))
  125.  
  126. #define allocate_mp_plural(offset) \
  127.   ({int __xxx=offset; \
  128.       allocate_integer(stacktop,(int) __xxx); })
  129.  
  130. #define mp_plural_offset(LObj) (intval(LObj))
  131.  
  132. /* keep compiler happy */
  133. #define intval_addr(x) \
  134.   &(x->INT.value_part)
  135.  
  136. /*----------------------------------------------------------------------------*
  137.  * Function   : Fn_mp_make_context
  138.  *
  139.  * Parameters : LispObject width:    Width of the new context
  140.  *         LispObject height:    Hwight of the new context
  141.  *
  142.  * Description: Creates a new context of size elements
  143.  *
  144.  * Result     : LispObject:    New Plural
  145.  *---------------------------------------------------------------------------*/
  146.  
  147.  
  148. EUFUN_2(Fn_mp_make_context,width,height)
  149. {
  150.   DBG_CALL("Error in mp-make-context");
  151.   LispObject mp_object;
  152.  
  153.   mp_object = allocate_mp_context( CallRequest((mp_make_context,8,intval(width),intval(height))));
  154.  
  155.   return mp_object;
  156. }
  157. EUFUN_CLOSE
  158.  
  159. /*----------------------------------------------------------------------------*
  160.  * Function   : Fn_mp_make_plural
  161.  *
  162.  * Parameters : LispObject context:    Address of a maspar context for the
  163.  *                                      new plural
  164.  *
  165.  * Description: Allocates a new Plural which has as its context (i.e 
  166.  *              processor set and context stack) context
  167.  *
  168.  * Result     : LispObject:    New Plural
  169.  *---------------------------------------------------------------------------*/
  170.  
  171. EUFUN_1( Fn_mp_make_plural, context )
  172. {
  173.   DBG_CALL("Error in mp-make-plural");
  174.   LispObject mp_object;
  175.  
  176.   mp_object = allocate_mp_plural( CallRequest((mp_make_plural,4,
  177.                           mp_context_address(context))));
  178.   return mp_object;
  179. }
  180. EUFUN_CLOSE
  181. /*----------------------------------------------------------------------------*
  182.  * Function   : Fn_mp_print
  183.  *
  184.  * Parameters : LispObject context:     Context and offset of
  185.  *              LispObject offset:    Plural to be printed.
  186.  *        LispObject width:    width of context if appropriate
  187.  *        LispObject partial:    and wether it is partial in x
  188.  *
  189.  * Description: Prints a plural variable in the usual fashion to the stdout
  190.  *
  191.  * Result     : LispObject plural:    offset of the printed plural
  192.  *---------------------------------------------------------------------------*/
  193.  
  194. EUFUN_5( Fn_mp_print, context, offset, width, partial, stream)
  195. {
  196.   DBG_CALL("Error in mp-print");
  197.   int i, j, w;
  198.   int transferred;
  199.   int firstline = 1;
  200.   char *chars;
  201.   int id;
  202.   
  203.   CallRequest((mp_plural, 20, mp_context_address(context),MP_PRINT, 1, 1,
  204.                          mp_plural_offset(offset)));
  205.  
  206.   transferred = blockIn(pe_scratch,fe_scratch,0,0,MASPAR_XLEN,
  207.             MASPAR_YLEN, SCRATCH_MEMORY_SIZE);
  208.   
  209.   if ((stream==NULL)||(stream==nil)) current_output = (StdOut->STREAM).handle;
  210.   else current_output = (stream->STREAM).handle;
  211.  
  212.   if (width == nil) {
  213.  
  214.     for (i=0; i<maspar_config; i++) {
  215.  
  216.       chars = fe_scratch + (i * SCRATCH_MEMORY_SIZE);
  217.  
  218.       while (*chars != NULL) {
  219.  
  220.     if (*chars == ((char) 1)) { 
  221.  
  222.       ++chars;
  223.       for (j=0; j< sizeof(int); j++) *(((char *) &id) + j) = *(chars++);
  224.       EUCALL_2(Fn_prin,TREF(fe_symbol_table,
  225.                 allocate_integer( stacktop,id )),stream);
  226.     }
  227.     else putc(*(chars++),current_output);
  228.       }
  229.  
  230.       if (chars != (fe_scratch + (i*SCRATCH_MEMORY_SIZE)))
  231.     putc(' ',current_output);
  232.     }
  233.   }
  234.   else {
  235.  
  236.     w = intval(width);
  237.     i = 0;
  238.     while (i < maspar_config) {
  239.       chars = fe_scratch + (i * SCRATCH_MEMORY_SIZE);
  240.       if (*chars == NULL) { ++i; continue; }
  241.       if ((w == intval(width)) && !firstline) fprintf(current_output,"\n   ");
  242.       while (*chars != NULL) {
  243.  
  244.     if (*chars == ((char) 1)) {
  245.  
  246.       ++chars;
  247.           for (j=0; j< sizeof(int); j++) *(((char *) &id) + j) = *(chars++);
  248.           EUCALL_2(Fn_prin,TREF(fe_symbol_table,
  249.                                 allocate_integer( stacktop,id )),stream);
  250.         }
  251.         else putc(*(chars++),current_output);
  252.       }
  253.       fprintf(current_output," ");
  254.       if ((--w) == 0) {
  255.     firstline = 0;
  256.     w = intval(width);
  257.     if (partial != nil) fprintf(current_output,"...");
  258. /*    fprintf(current_output,"\n");*/
  259.       }
  260.       ++i;
  261.     }
  262.   }
  263.   current_output = StdOut->STREAM.handle;
  264.  
  265.   return offset;
  266.   
  267.  
  268.   
  269. }
  270. EUFUN_CLOSE
  271.  
  272. /*----------------------------------------------------------------------------*
  273.  * Function   : encode_object
  274.  *
  275.  * Parameters : LispObject object:    object being encoded
  276.  *
  277.  * Description:    Recursively walks over a lisp object and encodes it into
  278.  *        fe_scratch, this can then be read by the back end to create
  279.  *        the object on the array. See mp_eubang.m for a fuller
  280.  *              description of the encoded format.
  281.  *
  282.  * Result     : int : arb
  283.  *---------------------------------------------------------------------------*/
  284.  
  285. #ifdef __STDC__
  286.  
  287. int encode (LispObject *stacktop, LispObject object)
  288.  
  289. #else
  290.  
  291. int encode (stacktop,object)
  292. LispObject *stacktop;
  293. LispObject object;
  294.  
  295. #endif
  296. {
  297.   int i;
  298.   float real;
  299.   LispObject new_id;
  300.  
  301.   if (fe_data_length >= (MASPAR_CONFIG*SCRATCH_MEMORY_SIZE)) {
  302.  
  303.     return EXCEEDED_SCRATCH_SPACE;
  304.   }
  305.  
  306.   if (is_fixnum(object)) {
  307.  
  308.     fe_scratch[fe_data_length++] = INTEGER;
  309.     memcpy(fe_scratch+fe_data_length, 
  310.        (char *) &(intval(object)), sizeof(int));
  311.     fe_data_length = fe_data_length + sizeof(int);
  312.  
  313.   }
  314.   else if (is_float(object)) {
  315.  
  316.     fe_scratch[fe_data_length++] = MP_FLOAT;
  317.     real = object->FLOAT.fvalue;
  318.     memcpy(fe_scratch+fe_data_length, 
  319.        (char *) &real, sizeof(float));
  320.     fe_data_length = fe_data_length + sizeof(float);
  321.  
  322.   }
  323.   else if (object == lisptrue) {
  324.  
  325.     fe_scratch[fe_data_length++] = MP_SPECIAL;
  326.     fe_scratch[fe_data_length++] = NOT_NIL;
  327.  
  328.   }
  329.   else if (is_symbol(object)) {
  330.  
  331.     int unique_symbol_key;
  332.  
  333.     if ((new_id = TREF(reffed_symbols,object)) == nil) {
  334.  
  335.       unique_symbol_key = next_symbol_key; /*  Symbol not reffed before, we */
  336.       ++next_symbol_key;               /*  need a new unique identifier */
  337.  
  338.       new_id = allocate_integer(stacktop,unique_symbol_key);
  339.       TREF_UPDATE(fe_symbol_table,new_id,object);
  340.       TREF_UPDATE(reffed_symbols,object,new_id);
  341.     }
  342.     else unique_symbol_key = (intval(new_id));
  343.  
  344.     fe_scratch[fe_data_length++] = MP_SYMBOL;
  345.     memcpy(fe_scratch+fe_data_length,
  346.        (char *) &unique_symbol_key, sizeof(char *));
  347.     fe_data_length = fe_data_length + sizeof(char *);
  348.   }
  349.   else if (is_vector(object)) {
  350.  
  351.     fe_scratch[fe_data_length++] = MP_VECTOR;
  352.  
  353.     fe_scratch[fe_data_length++] = object->VECTOR.length;
  354.     for (i=0; i<object->VECTOR.length; i++) {
  355.  
  356.       encode(stacktop,vref(object,i));
  357.  
  358.     }
  359.   }
  360.   else if (is_cons(object)) {
  361.  
  362.     fe_scratch[fe_data_length++] = MP_CONS;
  363.     STACK_TMP(object);
  364.     encode(stacktop,CAR(object));
  365.     UNSTACK_TMP(object);
  366.     encode(stacktop,CDR(object));
  367.  
  368.   }
  369.   else if (null(object)) {
  370.  
  371.     fe_scratch[fe_data_length++] = MP_SPECIAL;
  372.     fe_scratch[fe_data_length++] = NIL;
  373.  
  374.   }
  375.   else {
  376.  
  377.     return UNKNOWN_TYPE;
  378.  
  379.   }
  380.  
  381.   return SUCCESS; 
  382. }
  383.  
  384.  
  385. /*----------------------------------------------------------------------------*
  386.  * Function   : decode_object
  387.  *
  388.  * Parameters : char *start:    Where the description is located
  389.  *        int *index:    Current position in description buffer;
  390.  *
  391.  * Description: Builds a lisp structure from a coded description in des_buffer
  392.  *
  393.  * Result     : LispObject:     The resulting structure
  394.  *---------------------------------------------------------------------------*/
  395.  
  396. #ifdef __STDC__
  397.  
  398. LispObject decode_object ( LispObject *stacktop,char *start, int *index )
  399.  
  400. #else
  401.  
  402. LispObject decode_object ( stacktop,start, index )
  403.  
  404. char *start;
  405. int *index;
  406. LispObject *stacktop;
  407. #endif
  408.  
  409. {
  410.  
  411.   int i;
  412.   float real;
  413.   int   number;
  414.   int type;
  415.   int size;
  416.   int element;
  417.   int length = (int) *start;
  418.   LispObject decoded_car;
  419.   LispObject decoded_cdr;
  420.   LispObject result;
  421.   char *value_address;
  422.  
  423.   if (*index > length) return nil;
  424.  
  425.   type = (int) start[(*index)++];
  426.   
  427.   switch(type) {
  428.  
  429.   case MP_SPECIAL :
  430.  
  431.     if (start[(*index)++] == NOT_NIL) return lisptrue;
  432.     else return nil;
  433.  
  434.   case INTEGER :
  435.  
  436.     value_address = (char *) &number;
  437.     for (i=0; i<sizeof(int); i++) {
  438.  
  439.       *(value_address + i) = start[(*index)++];
  440.     }
  441.     return allocate_integer(stacktop, number );
  442.  
  443.   case MP_FLOAT :
  444.  
  445.     value_address = (char *) ℜ
  446.     for (i=0; i<sizeof(int); i++) {
  447.  
  448.       *(value_address + i) = start[(*index)++];
  449.     }
  450.     return allocate_float( stacktop,real );
  451.  
  452.   case MP_SYMBOL :
  453.     
  454.     value_address = (char *) &number;
  455.     for (i=0; i<sizeof(int); i++) *(value_address + i) = start[(*index)++];
  456.     return TREF(fe_symbol_table,allocate_integer(stacktop,number));
  457.  
  458.  
  459.   case MP_CONS :
  460.     decoded_car = decode_object(stacktop,start,index);
  461.     STACK_TMP(decoded_car);
  462.     decoded_cdr = decode_object(stacktop,start,index);
  463.     UNSTACK_TMP(decoded_car);
  464.     return EUCALL_2(Fn_cons,decoded_car,decoded_cdr);
  465.     
  466.   case MP_VECTOR :
  467.  
  468.     size = start[(*index)++];
  469.     result = allocate_vector(stacktop,size);
  470.     for (i=0; i<size; i++) {
  471.       LispObject xx;
  472.       STACK_TMP(result);
  473.       xx=decode_object(stacktop,start,index);
  474.       vecrefupdator(result,i,xx);
  475.       UNSTACK_TMP(result);
  476.     }
  477.     return result;
  478.  
  479.   default :
  480.  
  481.     return allocate_integer( stacktop,999 );
  482.   }
  483. }
  484.  
  485. /*----------------------------------------------------------------------------*
  486.  * Function   : Fn_mp_ref
  487.  *
  488.  * Parameters : LispObject context:     context and offset of
  489.  *              LispObject offset:    Plural we are examining
  490.  *        LispObject index:    Element of plural to examine
  491.  *
  492.  * Description: Extracts an element from a plural to create a singular front
  493.  *        end lispobject. This is done by the back end encoding the
  494.  *        the structure into a character string and this is copied 
  495.  *        to the front end and used to build a replica.
  496.  *
  497.  * Result     : LispObject:    Built structure.
  498.  *---------------------------------------------------------------------------*/
  499.  
  500. EUFUN_3( Fn_mp_ref, context, offset, index )
  501. {
  502.   DBG_CALL("Error in mp-ref");
  503.   LispObject result;
  504.   int proc_id;
  505.   int xproc_id;
  506.   int yproc_id;
  507.   int scratch_index = 1;
  508.   int transferred;
  509.  
  510.   proc_id=callRequest(mp_plural,24,mp_context_address(context), MP_REF,2,1,
  511.                            mp_plural_offset(offset),intval(index));
  512.   copyIn((char *) &mp_error, &fe_mp_error, sizeof(int));
  513.   if (fe_mp_error != MP_GREEN) CallError(stacktop,dbg_fname,allocate_integer(stacktop,fe_mp_error),NONCONTINUABLE);
  514.  
  515.   xproc_id = proc_id % MASPAR_XLEN;
  516.   yproc_id = proc_id / MASPAR_XLEN;
  517.  
  518.   transferred = blockIn(pe_scratch,fe_scratch,xproc_id,yproc_id,1,1,
  519.              SCRATCH_MEMORY_SIZE);
  520.  
  521.   result = decode_object(stacktop, (char *) fe_scratch, &scratch_index);
  522.  
  523.  
  524.   return result;
  525. }
  526. EUFUN_CLOSE
  527.  
  528. /*----------------------------------------------------------------------------*
  529.  * Function   : Fn_mp_set
  530.  *
  531.  * Parameters : LispObject context:    Context and offset of the plural
  532.  *        LispObject offset:    we wish to update
  533.  *        LispObject index:    Element we wish to update
  534.  *        LispObject object:    Object to go into element of plural
  535.  *
  536.  * Description:    Recursively descends the object and encodes it into the
  537.  *        the scratch buffer. This buffer is then read by the back 
  538.  *        end to build a similar object on the appropriate PE.
  539.  *
  540.  * Result     : LispObject plural
  541.  *---------------------------------------------------------------------------*/
  542.  
  543. EUFUN_4( Fn_mp_set, context, offset, index, object )
  544. {
  545.   DBG_CALL("Error in mp-set");
  546.   fe_data_length = sizeof(int);
  547.   /* not gc proof */
  548.   encode( stacktop,object );             /* Encode obejct into fe communication space */
  549.   
  550.   memcpy(fe_scratch, (char *) &fe_data_length, sizeof(int));
  551.   
  552.   CallRequest((mp_plural,28,mp_context_address(context), MP_SET, 3, 1,
  553.                mp_plural_offset(offset),
  554.                        intval(index),fe_scratch));
  555.  
  556.   return offset;
  557. }
  558. EUFUN_CLOSE
  559.   
  560. /*----------------------------------------------------------------------------*
  561.  * Function   : Fn_mp_bang
  562.  *
  563.  * Parameters : LispObject context:
  564.  *        LispObject object:
  565.  *
  566.  * Description:    Recursively descends the object and encodes it into the
  567.  *        the scratch buffer. This buffer is then read by the back 
  568.  *        end to build a similar object on all active PEs, i.e. the
  569.  *              ones in the context
  570.  *
  571.  * Result     : LispObject:  offset of new plural
  572.  *---------------------------------------------------------------------------*/
  573.  
  574. EUFUN_2( Fn_mp_bang, context, object )
  575. {
  576.   DBG_CALL("Error in mp-bang");
  577.   LispObject result;
  578.  
  579.   fe_data_length = sizeof(int);
  580.   /* not gc proof */
  581.   encode( stacktop, object );             /* Encode obejct into fe communication space */
  582.  
  583.   memcpy(fe_scratch, (char *) &fe_data_length, sizeof(int));
  584.  
  585.   result=allocate_mp_plural(CallRequest((mp_plural, 20,
  586.                    mp_context_address(context),
  587.                    MP_BANG, 1, 0,
  588.                    fe_scratch)));
  589.   
  590.   return result;
  591. }
  592. EUFUN_CLOSE
  593.  
  594. /*----------------------------------------------------------------------------*
  595.  * Function   : Fn_mp_assign
  596.  *
  597.  * Parameters : LispObject context:    context of the plurals (we trust)
  598.  *              LispObject dest:    offset of Plural to assign to
  599.  *        LispObject from:    offset Plural to assign from
  600.  *
  601.  * Description: Copies the contents of the from into dest. The operation is
  602.  *        sensitive to the current context - this means it can be used 
  603.  *        to combine the results of mp-if and mp-else.
  604.  *
  605.  * Result     : LispObject dest
  606.  *---------------------------------------------------------------------------*/
  607.  
  608. EUFUN_3( Fn_mp_assign, context, dest, from )
  609. {
  610.   DBG_CALL("Error in mp-assign");
  611.   int result;
  612.  
  613.   result = CallRequest((mp_plural,24,mp_context_address(context), MP_ASSIGN,2,2,
  614.                             mp_plural_offset(dest),
  615.                             mp_plural_offset(from)));
  616.  
  617.   return dest;
  618. }
  619. EUFUN_CLOSE
  620.  
  621. /*----------------------------------------------------------------------------*
  622.  * Function   : Fn_mp_cons
  623.  *
  624.  * Parameters : LispObject  context:    Context of the two plurals
  625.  *              LispObject    car:    Plural to be car of new plural pair
  626.  *        LispObject    cdr:    Plural to be cdr of new plural pair
  627.  *
  628.  * Description:    Takes two (conformant) plurals and returns plural of 
  629.  *        their cons.
  630.  *
  631.  * Result     : LispObject    cons:
  632.  *---------------------------------------------------------------------------*/
  633.  
  634. EUFUN_3( Fn_mp_cons, context, car, cdr )
  635. {
  636.   DBG_CALL("Error in mp-cons");
  637.   LispObject pair;
  638.  
  639.   pair = allocate_mp_plural(CallRequest((mp_plural,24,
  640.                     mp_context_address(context),
  641.                     MP_MP_CONS,2,2,
  642.                     mp_plural_offset(car),
  643.                     mp_plural_offset(cdr))));
  644.  
  645.   return pair;
  646. }
  647. EUFUN_CLOSE
  648. /*----------------------------------------------------------------------------*
  649.  * Function   : Fn_mp_car
  650.  *
  651.  * Parameters : LispObject context:     context of pair
  652.  *              LispObject pair:    plural pair to take car of
  653.  *
  654.  * Description:    creates new plural whose value is the car of pair
  655.  *
  656.  * Result     : LispObject     NULL - failure, see mp_error
  657.  *                address of mp_object
  658.  *---------------------------------------------------------------------------*/
  659.  
  660. EUFUN_2( Fn_mp_car, context, pair )
  661. {
  662.   DBG_CALL("Error in mp-car");
  663.   LispObject car;
  664.  
  665.   car = allocate_mp_plural(CallRequest((mp_plural,20,
  666.                        mp_context_address(context),MP_CAR,1,1,
  667.                        mp_plural_offset(pair))));
  668.  
  669.   return car;
  670. }
  671. EUFUN_CLOSE
  672.  
  673. /*----------------------------------------------------------------------------*
  674.  * Function   : Fn_mp_cdr
  675.  *
  676.  * Parameters : LispObject context:     context of pair
  677.  *              LispObject pair:    plural pair to take cdr of
  678.  *
  679.  * Description:    creates new plural whose value is the cdr of pair
  680.  *
  681.  * Result     : LispObject     NULL - failure, see mp_error
  682.  *                address of mp_object
  683.  *---------------------------------------------------------------------------*/
  684.  
  685. EUFUN_2( Fn_mp_cdr, context, pair )
  686. {
  687.   DBG_CALL("Error in mp-cdr");
  688.   LispObject cdr;
  689.  
  690.   cdr = allocate_mp_plural(CallRequest((mp_plural,20,
  691.                        mp_context_address(context),MP_CDR,1,1,
  692.                        mp_plural_offset(pair))));
  693.  
  694.   return cdr;
  695. }
  696. EUFUN_CLOSE
  697.  
  698. /*----------------------------------------------------------------------------*
  699.  * Function   : Fn_mp_rplac_d
  700.  *
  701.  * Parameters : LispObject context:     context of pair and value
  702.  *              LispObject pair:    plural pair to replace cdr of
  703.  *        LispObject value:    plural value to become cdr of pair
  704.  *
  705.  * Description:    Replaces the existing cdr of the pair to be value
  706.  *
  707.  * Result     : LispObject     pair - SUCCESS
  708.  *                NULL - Failure, see mp_error
  709.  *---------------------------------------------------------------------------*/
  710.  
  711. EUFUN_3( Fn_mp_rplac_d, context, pair, value )
  712. {
  713.   DBG_CALL("Error in mp-rplac-d");
  714.   int result;
  715.  
  716.   result = CallRequest((mp_plural,24,mp_context_address(context),MP_RPLAC_D,2,2,
  717.                             mp_plural_offset(pair),
  718.                             mp_plural_offset(value)));
  719.  
  720.   return pair;
  721. }
  722. EUFUN_CLOSE
  723. /*----------------------------------------------------------------------------*
  724.  * Function   : Fn_mp_rplac_a
  725.  *
  726.  * Parameters : LispObject context:     Context of pair and value
  727.  *              LispObject pair:    plural pair to replace car of
  728.  *        LispObject value:    plural value to become car of pair
  729.  *
  730.  * Description:    Replaces the existing car of the pair to be value
  731.  *
  732.  * Result     : LispObject     pair - SUCCESS
  733.  *                NULL - Failure, see mp_error
  734.  *---------------------------------------------------------------------------*/
  735.  
  736. EUFUN_3( Fn_mp_rplac_a, context, pair, value )
  737. {
  738.   DBG_CALL("Error in mp-rplac-a");
  739.   int result;
  740.  
  741.   result = CallRequest((mp_plural,24,mp_context_address(context),MP_RPLAC_A,2,2,
  742.                             mp_plural_offset(pair),
  743.                             mp_plural_offset(value)));
  744.  
  745.   return pair;
  746. }
  747. EUFUN_CLOSE
  748.  
  749. /*----------------------------------------------------------------------------*
  750.  * Function   : Fn_mp_make_vector
  751.  *
  752.  * Parameters : LispObject context:     Context of the plural of lengths
  753.  *              LispObject length:    Desrired lengths of the vectors
  754.  *
  755.  * Description: Allocates vectors of the given lengths and initialises all
  756.  *        the elements to nil
  757.  *
  758.  * Result     : LispObject:    New plural of vectors
  759.  *---------------------------------------------------------------------------*/
  760.  
  761. EUFUN_2( Fn_mp_make_vector, context, length )
  762. {
  763.   DBG_CALL("Error in mp-make-vector");
  764.   LispObject result;
  765.  
  766.   result = allocate_mp_plural(CallRequest((mp_plural,20,
  767.                       mp_context_address(context),
  768.                       MP_MAKE_VECTOR,1,1,
  769.                       mp_plural_offset(length))));
  770.  
  771.   return result;
  772. }
  773. EUFUN_CLOSE
  774.  
  775. /*----------------------------------------------------------------------------*
  776.  * Function   : Fn_mp_vector_length
  777.  *
  778.  * Parameters : LispObject context:     Context of plural of vectors
  779.  *              LispObject vector:    Plural of vectors
  780.  *
  781.  * Description: Creates a plural in which every active element contains the]
  782.  *        length of the vector in the argument plural
  783.  *
  784.  * Result     : LispObject lengths
  785.  *---------------------------------------------------------------------------*/
  786.  
  787. EUFUN_2( Fn_mp_vector_length, context, vector )
  788. {
  789.   DBG_CALL("Error in mp-vector-length");
  790.   LispObject result;
  791.  
  792.   result = allocate_mp_plural(CallRequest((mp_plural,20,
  793.                       mp_context_address(context),
  794.                       MP_VECTOR_LENGTH,1,1,
  795.                       mp_plural_offset(vector))));
  796.  
  797.   return result;
  798. }
  799. EUFUN_CLOSE
  800. /*----------------------------------------------------------------------------*
  801.  * Function   : Fn_mp_vector_ref
  802.  *
  803.  * Parameters : LispObject context:     Context of vector and index
  804.  *              LispObject vector:    Plural of vectors to reference
  805.  *        LispObject index:    Plural of integers to reference by
  806.  *
  807.  * Description: Creates a new plural in which the value of each active element
  808.  *        is the contents of the index th element of each vector
  809.  *
  810.  * Result     : LispObject:    referenced objects
  811.  *---------------------------------------------------------------------------*/
  812.  
  813. EUFUN_3( Fn_mp_vector_ref, context, vector, index )
  814. {
  815.   DBG_CALL("Error in mp-vector-ref");
  816.   LispObject result;
  817.  
  818.   result = allocate_mp_plural(CallRequest((mp_plural,24,
  819.                       mp_context_address(context),
  820.                       MP_VECTOR_REF,2,2,
  821.                       mp_plural_offset(vector),
  822.                       mp_plural_offset(index))));
  823.  
  824.   return result;
  825. }
  826. EUFUN_CLOSE
  827.  
  828. /*----------------------------------------------------------------------------*
  829.  * Function   : Fn_mp_vector_set
  830.  *
  831.  * Parameters : LispObject context:     Context of all the operands
  832.  *              LispObject vector:    Plural of vector to be updated
  833.  *        LispObject index:    PLural of integers indicating elements
  834.  *                    to be updated
  835.  *        LispObject value:    Plural of objects which are to be the
  836.  *                    new value of th indexth element of
  837.  *                    each vector
  838.  *
  839.  * Description: Updates the indexth element of each active vector to
  840.  *        be value.
  841.  *
  842.  * Result     : LispObject vector
  843.  *---------------------------------------------------------------------------*/
  844.  
  845. EUFUN_4( Fn_mp_vector_set, context, vector, index, value )
  846. {
  847.   DBG_CALL("Error in mp-vector-set");
  848.   int result;
  849.  
  850.   result = CallRequest((mp_plural,28,mp_context_address(context),
  851.                             MP_VECTOR_SET,3,3,
  852.                     mp_plural_offset(vector),
  853.                     mp_plural_offset(index),
  854.                     mp_plural_offset(value)));
  855.  
  856.   return vector;
  857. }
  858. EUFUN_CLOSE
  859.  
  860. /*----------------------------------------------------------------------------*
  861.  * Function   : Fn_mp_vector_merge
  862.  *
  863.  * Parameters : LispObject context:     Context of vector and index
  864.  *              LispObject vector:    Plural of vectors to reference
  865.  *        LispObject index:    Plural of integers to reference by
  866.  *
  867.  * Description: Creates a new plural in which the value of each active element
  868.  *        is the contents of the index th element of each vector
  869.  *
  870.  * Result     : LispObject:    referenced objects
  871.  *---------------------------------------------------------------------------*/
  872.  
  873. EUFUN_3( Fn_mp_vector_merge, context, set1, set2 )
  874. {
  875.   DBG_CALL("Error in mp-vector-merge");
  876.   LispObject result;
  877.  
  878.   result = allocate_mp_plural(CallRequest((mp_plural,24,
  879.                       mp_context_address(context),
  880.                       MP_VECTOR_MERGE,2,2,
  881.                       mp_plural_offset(set1),
  882.                       mp_plural_offset(set2))));
  883.  
  884.   return result;
  885. }
  886. EUFUN_CLOSE
  887.  
  888. /*----------------------------------------------------------------------------*
  889.  * Function   : Fn_mp_if
  890.  *
  891.  * Parameters : LispObject context:     Context of the boolean
  892.  *              LispObject plural_bool:    Plural variable to be treated as
  893.  *                    bool - at this time should be
  894.  *                    integers.
  895.  *
  896.  * Description:    This bool will be combined with the value on the 
  897.  *        context stack for this plural to create the new value on 
  898.  *        the context stack. All plurals conformant to this one
  899.  *        will be affected by this change
  900.  *
  901.  * Result     : LispObject t     Some of the processors are active
  902.  *                         nil   None of the processors are active
  903.  *---------------------------------------------------------------------------*/
  904.  
  905. EUFUN_2( Fn_mp_if, context, plural_bool )
  906. {
  907.   DBG_CALL("Error in mp-if");
  908.   int result;
  909.  
  910.   result = CallRequest((mp_plural,20,mp_context_address(context),
  911.                   MP_IF,1,1,mp_plural_offset(plural_bool)));
  912.  
  913.   if (result == MP_NONE_ACTIVE) return nil;
  914.   return lisptrue;
  915. }
  916. EUFUN_CLOSE
  917.  
  918. /*----------------------------------------------------------------------------*
  919.  * Function   : Fn_mp_elif
  920.  *
  921.  * Parameters : LispObject context:     Context of the boolean
  922.  *
  923.  * Description: Similar to mp-fi, but the preceding context is updated to 
  924.  *              show how many sites have yet to satisfy a predicate in
  925.  *              a cond expression, the n\behaviour of which is similar to
  926.  *              a switch statement in mpl.
  927.  *
  928.  * Result     : LispObject t     Some of the processors are active
  929.  *                         nil   None of the processors are active
  930.  *---------------------------------------------------------------------------*/
  931.  
  932. EUFUN_1( Fn_mp_elif, context )
  933. {
  934.   DBG_CALL("Error in mp-elif");
  935.   int result;
  936.  
  937.   result = CallRequest((mp_plural,16,mp_context_address(context),
  938.                   MP_ELIF,0,0));
  939.  
  940.   if (result == MP_NONE_ACTIVE) return nil;
  941.   return lisptrue;
  942. }
  943. EUFUN_CLOSE
  944.  
  945. /*----------------------------------------------------------------------------*
  946.  * Function   : Fn_mp_else
  947.  *
  948.  * Parameters : LispObject context:     Context whose stack we are changing
  949.  *
  950.  * Description: The currenty context is muodified to give the affect that
  951.  *        the bool given to mp_if had the not of its value. This
  952.  *        destructively modifies the top of the stack
  953.  *
  954.  * Result     : LispObject plural
  955.  *---------------------------------------------------------------------------*/
  956.  
  957. EUFUN_1( Fn_mp_else, context )
  958. {
  959.   DBG_CALL("Error in mp-else");
  960.   int result;
  961.   
  962.   result = CallRequest((mp_plural,16,mp_context_address(context),MP_ELSE,0,0));
  963.  
  964.   if (result == MP_NONE_ACTIVE) return nil;
  965.   return lisptrue;
  966. }
  967. EUFUN_CLOSE
  968.  
  969. /*----------------------------------------------------------------------------*
  970.  * Function   : Fn_mp_fi
  971.  *
  972.  * Parameters : LispObject context:    Context for which the stack is 
  973.  *                    to be popped once.
  974.  *
  975.  * Description: Removes the top entry from the contect stack for this
  976.  *        plural. Assuming there is one - error otherwise. This
  977.  *        will affect all those plurals conformant to this one.
  978.  *
  979.  * Result     : LispObject plural
  980.  *---------------------------------------------------------------------------*/
  981.  
  982. EUFUN_1( Fn_mp_fi, context )
  983. {
  984.   DBG_CALL("Error in mp-fi");
  985.   int result;
  986.  
  987.   result = CallRequest((mp_plural,16,mp_context_address(context),MP_FI,0,0));
  988.  
  989.   return context;
  990. }
  991. EUFUN_CLOSE
  992.  
  993. /*----------------------------------------------------------------------------*
  994.  * Function   : Fn_mp_context
  995.  *
  996.  * Parameters : LispObject context:    context the stack of which we are
  997.  *                                      interested in
  998.  *
  999.  * Description: Prints out the context of the plural as a plural of lists
  1000.  *
  1001.  * Result     : LispObject plural
  1002.  *---------------------------------------------------------------------------*/
  1003.  
  1004. EUFUN_1( Fn_mp_context, context )
  1005. {
  1006.   DBG_CALL("Error in mp-context");
  1007.   int i,transferred;
  1008.  
  1009.   return allocate_mp_plural( CallRequest((mp_plural,16,mp_context_address(context),MP_CONTEXT,0,0)));
  1010.  
  1011. }
  1012. EUFUN_CLOSE
  1013.  
  1014. /*----------------------------------------------------------------------------*
  1015.  * Function   : Fn_mp_and
  1016.  *
  1017.  * Parameters : LispObject context:     Context of the two operands
  1018.  *              LispObject arg1:    Two plurals of lisp thingys to
  1019.  *        LispObject arg2:    have a lisp style and done on em.
  1020.  *
  1021.  * Description: Preforms an element wise and on the two CONFORMANT plurals
  1022.  *        i.e. NIL has the role of FALSE, anything else is TRUE
  1023.  *
  1024.  * Result     : LispObject:    resulting boolean(ish) plural
  1025.  *---------------------------------------------------------------------------*/
  1026.  
  1027. EUFUN_3( Fn_mp_and, context, arg1, arg2 )
  1028. {
  1029.   DBG_CALL("Error in mp-and");
  1030.   LispObject result;
  1031.   
  1032.   result = allocate_mp_plural(CallRequest((mp_plural,24,
  1033.                       mp_context_address(context),
  1034.                       MP_AND,2,2,
  1035.                       mp_plural_offset(arg1),
  1036.                       mp_plural_offset(arg2))));
  1037.  
  1038.   return result;
  1039. }
  1040. EUFUN_CLOSE
  1041.  
  1042. /*----------------------------------------------------------------------------*
  1043.  * Function   : Fn_mp_or
  1044.  *
  1045.  * Parameters : LispObject context:     Context of the two operands
  1046.  *              LispObject arg1:    Two plurals of lisp thingys to
  1047.  *        LispObject arg2:    have a lisp style and done on em.
  1048.  *
  1049.  * Description: Preforms an element wise or on the two CONFORMANT plurals
  1050.  *        i.e. NIL has the role of FALSE, anything else is TRUE
  1051.  *
  1052.  * Result     : LispObject:    resulting boolean(ish) plural
  1053.  *---------------------------------------------------------------------------*/
  1054.  
  1055. EUFUN_3( Fn_mp_or, context, arg1, arg2 )
  1056. {
  1057.   DBG_CALL("Error in mp-or");
  1058.   LispObject result;
  1059.  
  1060.   result = allocate_mp_plural(CallRequest((mp_plural,24,
  1061.                       mp_context_address(context),
  1062.                       MP_OR,2,2,
  1063.                       mp_plural_offset(arg1),
  1064.                       mp_plural_offset(arg2))));
  1065.  
  1066.   return result;
  1067. }
  1068. EUFUN_CLOSE
  1069.  
  1070. /*----------------------------------------------------------------------------*
  1071.  * Function   : Fn_mp_not
  1072.  *
  1073.  * Parameters : LispObject context:     Context of the two operands
  1074.  *              LispObject arg1:    Two plurals of lisp thingys to
  1075.  *
  1076.  * Description: Preforms an element wise or on the two CONFORMANT plurals
  1077.  *        i.e. NIL has the role of FALSE, anything else is TRUE
  1078.  *
  1079.  * Result     : LispObject:    resulting boolean(ish) plural
  1080.  *---------------------------------------------------------------------------*/
  1081.  
  1082. EUFUN_2( Fn_mp_not, context, arg1 )
  1083. {
  1084.   DBG_CALL("Error in mp-not");
  1085.   LispObject result;
  1086.  
  1087.   result = allocate_mp_plural(CallRequest((mp_plural,20,
  1088.                       mp_context_address(context),
  1089.                       MP_NOT,1,1,
  1090.                       mp_plural_offset(arg1))));
  1091.  
  1092.   return result;
  1093. }
  1094. EUFUN_CLOSE
  1095.  
  1096.  
  1097. /*----------------------------------------------------------------------------*
  1098.  * Function   : Fn_mp_bin_op
  1099.  *
  1100.  * Parameters : LispObject context:     The context of the operands
  1101.  *              LispObject arg1:    Two conformant plurals of integers
  1102.  *        LispObject arg2:    
  1103.  *        LispObject op_id:    The operation id - an integer
  1104.  *
  1105.  * Description:    Creates a new plural whose content is the result of 
  1106.  *        applying the desired binary operation to the two given plurals
  1107.  *
  1108.  * Result     : LispObject result
  1109.  *---------------------------------------------------------------------------*/
  1110.  
  1111. EUFUN_4( Fn_mp_bin_op, context, arg1, arg2, op_id )
  1112. {
  1113.   DBG_CALL("Error in mp-bin-op");
  1114.   LispObject result;
  1115.  
  1116.   result = allocate_mp_plural(CallRequest((mp_plural, 28, 
  1117.                       mp_context_address(context),
  1118.                       MP_BIN_OP, 3, 2,
  1119.                       mp_plural_offset(arg1),
  1120.                       mp_plural_offset(arg2),
  1121.                       intval(op_id))));
  1122.  
  1123.   return result;
  1124. }
  1125. EUFUN_CLOSE
  1126.  
  1127. /*----------------------------------------------------------------------------*
  1128.  * Function   : Fn_mp_rel_op
  1129.  *
  1130.  * Parameters : LispObject context:     The context of the operands
  1131.  *              LispObject arg1:    Two conformant plurals of integers
  1132.  *        LispObject arg2:    
  1133.  *        LispObject op_id:    The operation id - an integer
  1134.  *
  1135.  * Description:    Creates a new plural whose content is the result of 
  1136.  *        applying the desired relary operation to the two given plurals
  1137.  *
  1138.  * Result     : LispObject result
  1139.  *---------------------------------------------------------------------------*/
  1140.  
  1141. EUFUN_4( Fn_mp_rel_op, context, arg1, arg2, op_id )
  1142. {
  1143.   DBG_CALL("Error in mp-rel-op");
  1144.   LispObject result;
  1145.  
  1146.   result = allocate_mp_plural(CallRequest((mp_plural, 28, 
  1147.                       mp_context_address(context),
  1148.                       MP_REL_OP, 3, 2,
  1149.                       mp_plural_offset(arg1),
  1150.                       mp_plural_offset(arg2),
  1151.                       intval(op_id))));
  1152.  
  1153.   return result;
  1154. }
  1155. EUFUN_CLOSE
  1156.  
  1157. /*----------------------------------------------------------------------------*
  1158.  * Function   : Fn_mp_un_op
  1159.  *
  1160.  * Parameters : LispObject context:     The context of the operand
  1161.  *              LispObject arg:            Plural of ints and/or floats
  1162.  *        LispObject op_id:    The operation id - an integer
  1163.  *
  1164.  * Description:    Creates a new plural whose content is the result of 
  1165.  *        applying the desired unary operation to the given plural
  1166.  *
  1167.  * Result     : LispObject result
  1168.  *---------------------------------------------------------------------------*/
  1169.  
  1170. EUFUN_3( Fn_mp_un_op, context, arg, op_id )
  1171. {
  1172.   DBG_CALL("Error in mp-un-op");
  1173.   LispObject result;
  1174.  
  1175.   result = allocate_mp_plural(CallRequest((mp_plural, 24, 
  1176.                       mp_context_address(context),
  1177.                       MP_UN_OP, 2, 1,
  1178.                       mp_plural_offset(arg),
  1179.                       intval(op_id))));
  1180.  
  1181.   return result;
  1182. }
  1183. EUFUN_CLOSE
  1184. /*----------------------------------------------------------------------------*
  1185.  * Function   : Fn_mp_scan_op
  1186.  *
  1187.  * Parameters : LispObject context:     The context of the operand
  1188.  *              LispObject arg:            Plural of ints and/or floats
  1189.  *        LispObject op_id:    The operation id - an integer
  1190.  *
  1191.  * Description:    Creates a new plural whose content is the result of 
  1192.  *        applying the desired scan operation to the given plural
  1193.  *
  1194.  * Result     : LispObject result
  1195.  *---------------------------------------------------------------------------*/
  1196.  
  1197. EUFUN_3( Fn_mp_scan_op, context, arg, op_id )
  1198. {
  1199.   DBG_CALL("Error in mp-scan-op");
  1200.   LispObject result;
  1201.  
  1202.   result = allocate_mp_plural(CallRequest((mp_plural, 24, 
  1203.                       mp_context_address(context),
  1204.                       MP_SCAN_OP, 2, 1,
  1205.                       mp_plural_offset(arg),
  1206.                       intval(op_id))));
  1207.  
  1208.   return result;
  1209. }
  1210. EUFUN_CLOSE
  1211. /*----------------------------------------------------------------------------*
  1212.  * Function   : Fn_mp_random
  1213.  *
  1214.  * Parameters : LispObject context:     The context of the operand
  1215.  *
  1216.  * Description:    Creates a new plural with a random integer in each element
  1217.  *
  1218.  * Result     : LispObject result: the offset of the resullting plural
  1219.  *---------------------------------------------------------------------------*/
  1220.  
  1221. EUFUN_1( Fn_mp_random, context )
  1222. {
  1223.   DBG_CALL("Error in mp-random");
  1224.   LispObject result;
  1225.  
  1226.   result = allocate_mp_plural(CallRequest((mp_plural, 16, 
  1227.                       mp_context_address(context),
  1228.                       MP_RANDOM, 0, 0)));
  1229.  
  1230.   return result;
  1231. }
  1232. EUFUN_CLOSE
  1233.  
  1234. /*----------------------------------------------------------------------------*
  1235.  * Function   : Fn_mp_test
  1236.  *
  1237.  * Parameters : LispObject context:     Context of the operands
  1238.  *              LispObject arg1:    Things we are testing
  1239.  *        LispObject type:    Things we hope the things are
  1240.  *
  1241.  * Description:    Returns a boolean plural dependfing on wether the things
  1242.  *        were the things or not.
  1243.  *
  1244.  * Result     : LispObject:    The resulting boolean
  1245.  *---------------------------------------------------------------------------*/
  1246.  
  1247. EUFUN_3( Fn_mp_test, context, arg1, type )
  1248. {
  1249.   DBG_CALL("Error in mp-test");
  1250.   LispObject result;
  1251.  
  1252.   result = allocate_mp_plural(CallRequest((mp_plural, 24, 
  1253.                       mp_context_address(context),
  1254.                       MP_TEST, 2, 1,
  1255.                       mp_plural_offset(arg1),
  1256.                       intval(type))));
  1257.  
  1258.   return result;
  1259. }
  1260. EUFUN_CLOSE
  1261.  
  1262. /*----------------------------------------------------------------------------*
  1263.  * Function   : Fn_mp_eq
  1264.  *
  1265.  * Parameters : LispObject context:     Context of the operands
  1266.  *              LispObject arg1:    The two plurals which are to be    
  1267.  *        LispObject arg2:    compared.
  1268.  *
  1269.  * Description: Returns a boolean plural dependent on wether the individual
  1270.  *              elements are equal. By value for floats and ints, by address
  1271.  *              for everything else.
  1272.  *
  1273.  * Result     : LispObject:  The resulting boolean plural
  1274.  *---------------------------------------------------------------------------*/
  1275.  
  1276. EUFUN_3( Fn_mp_eq, context, arg1, arg2 )
  1277. {
  1278.   DBG_CALL("Error in mp-eq");
  1279.   LispObject result;
  1280.   
  1281.   result = allocate_mp_plural(CallRequest((mp_plural,24,
  1282.                       mp_context_address(context),
  1283.                       MP_EQ,2,2,
  1284.                       mp_plural_offset(arg1),
  1285.                       mp_plural_offset(arg2))));
  1286.  
  1287.   return result;
  1288. }
  1289. EUFUN_CLOSE
  1290.  
  1291. /*----------------------------------------------------------------------------*
  1292.  * Function   : Fn_mp_length
  1293.  *
  1294.  * Parameters : LispObject context:    context to find length of.
  1295.  *
  1296.  * Description: Extracts the length of the plural from its handle on the 
  1297.  *        back end.
  1298.  *
  1299.  * Result     : LispObject:    INT->value = plural-length
  1300.  *---------------------------------------------------------------------------*/
  1301.  
  1302. EUFUN_1( Fn_mp_length,  context )
  1303. {
  1304.   DBG_CALL("Error in mp-length");
  1305.   int n;
  1306.  
  1307. /*  n = callRequest(mp_length,4,mp_context_address(context));
  1308.   return allocate_integer(stacktop,n); */
  1309.   return nil;
  1310. }
  1311. EUFUN_CLOSE
  1312. /*----------------------------------------------------------------------------*
  1313.  * Function   : Fn_mp_match
  1314.  *
  1315.  * Parameters : LispObject dest_context:Contex of destination plural
  1316.  *              LispObject dest:    Offset of destination plural
  1317.  *              LispObject from_context:Contex of source plural
  1318.  *        LispObject from:    Offset of Source plural
  1319.  *
  1320.  * Description: Builds a mapping plural - each element contains a list of
  1321.  *        processor ids - this is where each element will take
  1322.  *        data from to build a plural conformant to the destination
  1323.  *        plural - or something
  1324.  *
  1325.  * Result     : LispObject Fn_mp_match
  1326.  *---------------------------------------------------------------------------*/
  1327.  
  1328. EUFUN_4( Fn_mp_match, dest_contex, dest, from_contex, from )
  1329. {
  1330.   DBG_CALL("Error in mp-match");
  1331.   LispObject mapping;
  1332.  
  1333.   mapping = allocate_mp_plural(CallRequest((mp_match,16,
  1334.                        mp_context_address(dest_contex),
  1335.                        mp_plural_offset(dest),
  1336.                        mp_context_address(from_contex),
  1337.                        mp_plural_offset(from))));
  1338.  
  1339.   return mapping;
  1340. }
  1341. EUFUN_CLOSE
  1342.  
  1343. EUFUN_5( Fn_mp_move, context, data, map_context, map, initial_value )
  1344. {
  1345.   DBG_CALL("Error in mp-move");
  1346.   LispObject result;
  1347.  
  1348.   result = allocate_mp_plural(CallRequest((mp_move,20,
  1349.                                           mp_context_address(context),
  1350.                                           mp_plural_offset(data),
  1351.                                           mp_context_address(map_context),
  1352.                                           mp_plural_offset(map),
  1353.                       mp_plural_offset(initial_value))));
  1354.  
  1355.   return result;
  1356. }
  1357. EUFUN_CLOSE
  1358.  
  1359. /*----------------------------------------------------------------------------*
  1360.  * Function   : Fn_cm_put
  1361.  *
  1362.  * Parameters : LispObject data_context:    context of data to put
  1363.  *        LispObject data_offset:        offset of data to put
  1364.  *        LispObject dest_offset:        which procs to put to
  1365.  *        LispObject context:        context of result plural
  1366.  *
  1367.  * Description: Creates a new plural with context context, which contains 
  1368.  *        the objects in the data plural moved into it as specified
  1369.  *        by the destination plural. this operation requires no 
  1370.  *        matching and should make things quicker
  1371.  *
  1372.  * Result     : LispObject offset: together with context => result plural
  1373.  *---------------------------------------------------------------------------*/
  1374.  
  1375. EUFUN_4(Fn_cm_put, data_context, data_offset, dest_offset, context )
  1376. {
  1377.   DBG_CALL("Error in cm-put");
  1378.   int result;
  1379.  
  1380.   result = CallRequest((cm_put,16,
  1381.                mp_context_address(data_context),
  1382.                mp_plural_offset(data_offset),
  1383.                mp_plural_offset(dest_offset),
  1384.                mp_context_address(context)));
  1385.  
  1386.   return allocate_mp_plural(result);
  1387. }
  1388. EUFUN_CLOSE
  1389.  
  1390. /*----------------------------------------------------------------------------*
  1391.  * Function   : Fn_cm_start
  1392.  *
  1393.  * Parameters : LispObject context:    context of data to put
  1394.  * 
  1395.  * Description: returns the number of the PE the context starts at. This will
  1396.  *              allow to further inverse rendezvous without matching
  1397.  *
  1398.  * Result     : LispObject start: the PE number
  1399.  *---------------------------------------------------------------------------*/
  1400.  
  1401. EUFUN_1( Fn_cm_start, context )
  1402. {
  1403.   DBG_CALL("Error in cm-start");
  1404.   int n;
  1405.  
  1406.   n=callRequest(cm_start,4,mp_context_address(context));
  1407.   return allocate_integer(stacktop,n);
  1408. }
  1409. EUFUN_CLOSE  
  1410.  
  1411. /*----------------------------------------------------------------------------*
  1412.  * Function   : Fn_mp_x_stat
  1413.  *
  1414.  * Parameters : LispObject context:    Context of the boolean data
  1415.  *        LuspObject bool_data:    Offsets of the data
  1416.  *
  1417.  * Description: The call to the backend sets a boolean value in each PE
  1418.  *        this is then copied back and used as the argument to xlights
  1419.  *
  1420.  * Result     : LispObject: the arg
  1421.  *---------------------------------------------------------------------------*/
  1422.  
  1423.  
  1424. EUFUN_2( Fn_mp_x_stat, context, bool_data )
  1425. {
  1426.   DBG_CALL("Error in mp-x-stat");
  1427.   int transferred;
  1428.   int value;
  1429.   char c_value;
  1430.   int i,j;
  1431.   
  1432.   CallRequest((mp_plural, 20,  mp_context_address(context), MP_X_STAT, 1, 1,
  1433.                                     mp_plural_offset(bool_data)));
  1434.  
  1435.   transferred = blockIn(pe_scratch,fe_scratch,0,0,MASPAR_XLEN,
  1436.             MASPAR_YLEN, 1);
  1437. #ifdef XLIGHTS
  1438.   visualise(fe_scratch);
  1439. #else
  1440.   printf("\n");
  1441.   for (i=0; i<MASPAR_YLEN; i++) {
  1442.     for (j=0; j<MASPAR_XLEN; j++) {
  1443.       c_value = * (((char *) (fe_scratch)) + (i*MASPAR_XLEN) + j);
  1444.       value = c_value;
  1445.       printf(" %d", value);
  1446.     }
  1447.     printf("\n");
  1448.   }
  1449.   printf("\n");
  1450. #endif
  1451.  
  1452.   return bool_data;
  1453. }
  1454. EUFUN_CLOSE
  1455.  
  1456.  
  1457. /*----------------------------------------------------------------------------*
  1458.  * Function   : Fn_mp_gc
  1459.  *
  1460.  * Parameters : void
  1461.  *
  1462.  * Description: This is a temporary devlopment function to fire a GC process
  1463.  *              on the back end. It prints out memory stats at completion.
  1464.  *
  1465.  * Result     : LispObjectt: ()
  1466.  *---------------------------------------------------------------------------*/
  1467.  
  1468.  
  1469. EUFUN_0( Fn_mp_gc)
  1470. {
  1471.   DBG_CALL("Error in mp-gc");
  1472.   int transferred;
  1473.   int value;
  1474.   int x,y;
  1475.  
  1476.   callRequest(mp_gc, 0);
  1477.   
  1478.   transferred = blockIn(pe_scratch, fe_scratch,0 ,0, MASPAR_XLEN,
  1479.             MASPAR_YLEN, sizeof(float));
  1480.  
  1481. /*  printf("MasPar memory statistics:\n");
  1482.  *
  1483.  *  for(y=0; y<MASPAR_YLEN; y++) {
  1484.  *    for(x=0; x<MASPAR_XLEN; x++) {
  1485.  *      value = *(((int *) fe_scratch) + (y*MASPAR_YLEN) + x);
  1486.  *      if (value > 9) printf(" %d",value);
  1487.  *      else printf(" 0%d", value);
  1488.  *    }
  1489.  *    printf("\n");
  1490.  *  }
  1491.  *  printf("\n\n");
  1492.  */
  1493.   return nil;
  1494. }
  1495. EUFUN_CLOSE
  1496.  
  1497. /*----------------------------------------------------------------------------*
  1498.  * Function   : Fn_become_strange
  1499.  *
  1500.  * Parameters : LispObject normal:    to become strange
  1501.  *
  1502.  * Description: Marks the objects as being strange, i.e. a handle on a 
  1503.  *        back-end object. This function should be called by all
  1504.  *        creator functions.
  1505.  *
  1506.  * Result     : LispObject:    The now strange object
  1507.  *---------------------------------------------------------------------------*/
  1508.  
  1509. EUFUN_1( Fn_become_strange, normal )
  1510. {
  1511.   lval_typeof(normal)=TYPE_STRANGE;
  1512.   return normal;
  1513. }
  1514. EUFUN_CLOSE  
  1515.  
  1516.  
  1517. /*----------------------------------------------------------------------------*
  1518.  * Function   : keep_strange_things
  1519.  *
  1520.  * Parameters : LispObject strange_things
  1521.  *
  1522.  * Description: Creates a compact (i.e. not made out out of cons celss version
  1523.  *        version of the list which can then be paged onto the MasPar
  1524.  *        so that they can be marked as still being used and the 
  1525.  *        remainder reclaimed.
  1526.  *        PROB: if we run out of front end stack space we will "err".
  1527.  *            "So it goes!"
  1528.  *              SOLN: clear plurals space is a seperate to freeplurals
  1529.  *
  1530.  * Result     : LispObject :Number of active plurals
  1531.  *---------------------------------------------------------------------------*/
  1532.  
  1533. #ifdef __STDC__
  1534.  
  1535. void keep_strange_things( LispObject strange_list )
  1536.  
  1537. #else
  1538.  
  1539. void keep_strange_things( strange_list )
  1540.  
  1541. LispObject strange_list;
  1542.  
  1543. #endif
  1544. {
  1545.   unsigned short *pages = (unsigned short *) fe_scratch;
  1546.   LispObject strange_current;
  1547.   LispObject list_current;
  1548.   int no_of_plurals = 0;
  1549.   LispObject strange_ctxt, strange_ofst;
  1550.   LispObject current_ctxt, current_ofst;
  1551.   LispObject mapping_ofst;
  1552.  
  1553.   if (strange_list == 0) {
  1554.  
  1555.     if (callRequest(mp_free_plurals,8,fe_scratch,no_of_plurals) == FAIL)
  1556.  
  1557.       fprintf(stderr,"Major bummer during GC of plural handles\n");
  1558.  
  1559.     fprintf(stderr,"No Plural Handles\n");
  1560.     return;
  1561.   }
  1562.  
  1563.   while (TRUE) {
  1564.  
  1565.     strange_current = CAR(strange_list);
  1566.      
  1567.     current_ctxt = slotref(strange_current,0);
  1568.     current_ofst = slotref(strange_current,1);
  1569.     
  1570.     if (is_cons(current_ofst)) {                          /* must be a field */
  1571.  
  1572.       current_ctxt = slotref(current_ctxt,0); /* contexts list in paralation */
  1573.  
  1574.       while (is_cons(current_ctxt)) {
  1575.  
  1576.     strange_ctxt = CAR(current_ctxt);
  1577.     current_ctxt = CDR(current_ctxt);
  1578.     strange_ofst = CAR(current_ofst);
  1579.     if (is_cons(strange_ofst)) {
  1580.  
  1581.       while (is_cons(strange_ofst)) {
  1582.  
  1583.         mapping_ofst = CAR(strange_ofst);
  1584.         strange_ofst = CDR(strange_ofst);
  1585.  
  1586.         *(pages++) = (unsigned short) intval(strange_ctxt);
  1587.         *(pages++) = (unsigned short) intval(mapping_ofst);
  1588.  
  1589. fprintf(stderr,"context(16-bit): %hu offset(16-bit): %hu 32-bits %08x\n",
  1590.     *(pages-2), *(pages-1), *((unsigned *) (pages-2)));
  1591.  
  1592.         no_of_plurals++;
  1593.       }
  1594.     }
  1595.     else {
  1596.  
  1597.       current_ofst = CDR(current_ofst);
  1598.  
  1599.       *(pages++) = (unsigned short) intval(strange_ctxt);
  1600.       *(pages++) = (unsigned short) intval(strange_ofst);
  1601.  
  1602. fprintf(stderr,"context(16-bit): %hu offset(16-bit): %hu 32-bits %08x\n",
  1603.     *(pages-2), *(pages-1), *((unsigned *) (pages-2)));
  1604.       
  1605.       no_of_plurals++;
  1606.     }
  1607.       }
  1608.     }
  1609.     else {
  1610.  
  1611.       *(pages++) = (unsigned short) intval(current_ctxt);
  1612.       *(pages++) = (unsigned short) intval(current_ofst);
  1613.  
  1614. fprintf(stderr,"context(16-bit): %hu offset(16-bit): %hu 32-bits %08x\n",
  1615.     *(pages-2), *(pages-1), *((unsigned *) (pages-2)));
  1616.       
  1617.       no_of_plurals++;
  1618.     }
  1619.       
  1620.     if (CDR(strange_list) == strange_list) break;
  1621.     strange_list = CDR(strange_list);
  1622.  
  1623.   }
  1624.  
  1625.   if (callRequest(mp_free_plurals,8,fe_scratch,no_of_plurals) == FAIL)
  1626.  
  1627.     fprintf(stderr,"Major bummer during garbage collect of plural handles\n");
  1628.  
  1629.   fprintf(stderr,"%d active plurals\n",no_of_plurals);
  1630. }
  1631.  
  1632. /*----------------------------------------------------------------------------*
  1633.  * Function   : Fn_ps_ref
  1634.  *
  1635.  * Parameters : none
  1636.  *
  1637.  * Description: Returns value of plural space to the lisp environment
  1638.  *
  1639.  * Result     : LispObject pspace intgeger.
  1640.  *---------------------------------------------------------------------------*/
  1641.  
  1642. EUFUN_0(Fn_ps_ref)
  1643.  
  1644. {
  1645.   DBG_CALL("Error in ps-ref");
  1646.   unsigned short tmp;
  1647.  
  1648.   copyIn((char *) &plural_space,(char *) &tmp, sizeof(unsigned short));
  1649.  
  1650.   return allocate_integer(stacktop, (int) tmp);
  1651.   
  1652. }
  1653. EUFUN_CLOSE
  1654.  
  1655. EUFUN_1(Fn_ps_set,new_value)
  1656.  
  1657. {
  1658.   DBG_CALL("Error in ps-set");
  1659.   unsigned short tmp = (unsigned short) intval(new_value);
  1660.  
  1661.   copyOut( (char *) &tmp, (char *) &plural_space, sizeof(unsigned short));
  1662.  
  1663.   return(new_value);
  1664. }
  1665. EUFUN_CLOSE
  1666.  
  1667. /*----------------------------------------------------------------------------*
  1668.  * Function   : Fn_sb_ref
  1669.  *
  1670.  * Parameters : none
  1671.  *
  1672.  * Description: Returns value of stack base to the lisp environment
  1673.  *
  1674.  * Result     : LispObject pspace intgeger.
  1675.  *---------------------------------------------------------------------------*/
  1676.  
  1677. EUFUN_0(Fn_sb_ref)
  1678.  
  1679. {
  1680.   DBG_CALL("Error in sb-ref");
  1681.   unsigned short tmp;
  1682.  
  1683.   copyIn((char *) &stack_base,(char *) &tmp, sizeof(unsigned short));
  1684.  
  1685.   return allocate_integer(stacktop, (int) tmp);
  1686.   
  1687. }
  1688. EUFUN_CLOSE
  1689.  
  1690. EUFUN_1(Fn_sb_set,new_value)
  1691.  
  1692. {
  1693.   DBG_CALL("Error in sb-set");
  1694.   unsigned short tmp = (unsigned short) intval(new_value);
  1695.  
  1696.   copyOut( (char *) &tmp, (char *) &stack_base, sizeof(unsigned short));
  1697.  
  1698.   return(new_value);
  1699. }
  1700. EUFUN_CLOSE
  1701.  
  1702. /*----------------------------------------------------------------------------*
  1703.  * Function   : Fn_mp_config
  1704.  *
  1705.  * Parameters : none
  1706.  *
  1707.  * Description: Returns maspar lisp configuration
  1708.  *
  1709.  * Result     : LispObject pspace intgeger.
  1710.  *---------------------------------------------------------------------------*/
  1711.  
  1712. EUFUN_0(Fn_mp_config)
  1713.  
  1714. {
  1715.   DBG_CALL("Error in mp-config");
  1716.  
  1717.   return allocate_integer(stacktop, (maspar_config/2));
  1718.   
  1719. }
  1720. EUFUN_CLOSE
  1721.  
  1722.  
  1723. /*----------------------------------------------------------------------------*
  1724.  * Function   : Fn_dbg_on
  1725.  *
  1726.  * Parameters : none
  1727.  *
  1728.  * Description: Returns maspar lisp configuration
  1729.  *
  1730.  * Result     : LispObject pspace intgeger.
  1731.  *---------------------------------------------------------------------------*/
  1732.  
  1733. extern int debug_status;
  1734.  
  1735. EUFUN_0(Fn_dbg_on)
  1736.  
  1737. {
  1738.   DBG_CALL("Error in dbg-on");
  1739.   int tmp = 1;
  1740.  
  1741.   copyOut( (char *) &tmp, (char *) &debug_status, sizeof(int));
  1742.  
  1743.   return(lisptrue);
  1744. }
  1745. EUFUN_CLOSE
  1746.  
  1747. EUFUN_0(Fn_dbg_off)
  1748.  
  1749. {
  1750.   int tmp = 0;
  1751. DBG_CALL("Error in dbg-on");
  1752.  
  1753. fprintf(stderr,"We are now in Fn_dbg_on\n");
  1754.   copyOut( (char *) &tmp, (char *) &debug_status, sizeof(int));
  1755.  
  1756.   return(lisptrue);
  1757. }
  1758. EUFUN_CLOSE
  1759.  
  1760. /*----------------------------------------------------------------------------*
  1761.  * Function   : Fn_mp_edge
  1762.  *
  1763.  * Parameters : LispObject context:    The context whose contexts stacks
  1764.  *                    are to be munged
  1765.  *        LispObject direction:    The edge we want to be active
  1766.  *
  1767.  * Description: Like mp-if, makes one edge of a rectangular context active
  1768.  *
  1769.  * Result     : LispObject nil - no active elements
  1770.  *               t   - some active elements
  1771.  *---------------------------------------------------------------------------*/
  1772.  
  1773. EUFUN_2(Fn_mp_edge, context, direction)
  1774. {
  1775.   int result;
  1776. DBG_CALL("Error in mp_edge");
  1777.  
  1778. fprintf(stderr,"We are now in Fn_mp_edge\n");
  1779.   result = CallRequest((mp_edge,8,mp_context_address(context),
  1780.             intval(direction)));
  1781.  
  1782.   if (result == MP_SOME_ACTIVE) return lisptrue;
  1783.   return nil;
  1784. }
  1785. EUFUN_CLOSE
  1786.  
  1787. /*----------------------------------------------------------------------------*
  1788.  * Function   : Fn_xnet
  1789.  *
  1790.  * Parameters : LispObject context: Context which all the data is in
  1791.  *              LispObject direction: Where to get data from
  1792.  *              LispObject offsets: List of offsets (in order)
  1793.  *
  1794.  * Description: Extracts all the offsets and writes them into the scratch 
  1795.  *              space so that they can be block copied into the ACU and 
  1796.  *              dealt with there by mp_xnet
  1797.  *              This is a destructive operation
  1798.  *
  1799.  * Result     : LispObject lisptrue/nil FAIL/SUCCESS
  1800.  *---------------------------------------------------------------------------*/
  1801.  
  1802. EUFUN_3( Fn_xnet,  contexts , offsets, direction )
  1803.  
  1804. {
  1805.   LispObject current_ctxt_pair = contexts;
  1806.   LispObject current_ofst_pair = offsets;
  1807.   LispObject offset;
  1808.   LispObject context;
  1809.   int i = 0;
  1810.   unsigned short *pages = (unsigned short *) fe_scratch;
  1811. DBG_CALL("Error in mp-xnet");
  1812.  
  1813.   while (is_cons(current_ctxt_pair)) {
  1814.  
  1815.     context = CAR(current_ctxt_pair);
  1816.     current_ctxt_pair = CDR(current_ctxt_pair);
  1817.     pages[i++] = (unsigned short) intval(context);
  1818.     offset = CAR(current_ofst_pair);
  1819.     current_ofst_pair = CDR(current_ofst_pair);
  1820.     pages[i++] = (unsigned short) intval(offset);
  1821.   }
  1822.   i = i/2;
  1823.   CallRequest((mp_xnet,12,intval(direction),i,fe_scratch));
  1824.  
  1825.   return lisptrue;
  1826.  
  1827. }
  1828. EUFUN_CLOSE
  1829.  
  1830.  
  1831. /*----------------------------------------------------------------------------*
  1832.  * Function   : INIT_plural
  1833.  *
  1834.  * Parameters : void:
  1835.  *
  1836.  * Description:    Initialises Plural Module
  1837.  *
  1838.  * Result     : void:
  1839.  *---------------------------------------------------------------------------*/
  1840.  
  1841. #define PLURAL_ENTRIES (49)
  1842. MODULE Module_plural;
  1843. LispObject Module_plural_values[PLURAL_ENTRIES];
  1844.  
  1845. #ifdef __STDC__
  1846.  
  1847. void INIT_plural(LispObject *stacktop)
  1848.  
  1849. #else
  1850.  
  1851. void INIT_plural(stacktop)
  1852. LispObject *stacktop;
  1853. #endif
  1854.  
  1855.  
  1856. {
  1857.   DBG_CALL("Error in INIT_plural");
  1858.   open_module(stacktop,&Module_plural,Module_plural_values,"plural",PLURAL_ENTRIES);
  1859.  
  1860.   (void) make_module_function(stacktop,"mp-make-context",Fn_mp_make_context,2);
  1861.   (void) make_module_function(stacktop,"mp-make-plural",Fn_mp_make_plural,1);
  1862.   (void) make_module_function(stacktop,"mp-print",Fn_mp_print,5);
  1863.   (void) make_module_function(stacktop,"mp-set",Fn_mp_set,4);
  1864.   (void) make_module_function(stacktop,"mp-ref",Fn_mp_ref,3);
  1865.   (void) make_module_function(stacktop,"mp-bang",Fn_mp_bang,2);
  1866.   (void) make_module_function(stacktop,"mp-cons",Fn_mp_cons,3);
  1867.   (void) make_module_function(stacktop,"mp-car",Fn_mp_car,2);
  1868.   (void) make_module_function(stacktop,"mp-cdr",Fn_mp_cdr,2);
  1869.   (void) make_module_function(stacktop,"mp-rplac-a",Fn_mp_rplac_a,3);
  1870.   (void) make_module_function(stacktop,"mp-rplac-d",Fn_mp_rplac_d,3);
  1871.   (void) make_module_function(stacktop,"mp-if",Fn_mp_if,2);
  1872.   (void) make_module_function(stacktop,"mp-else",Fn_mp_else,1);
  1873.   (void) make_module_function(stacktop,"mp-file",Fn_mp_elif,1);
  1874.   (void) make_module_function(stacktop,"mp-fi",Fn_mp_fi,1);
  1875.   (void) make_module_function(stacktop,"mp-context",Fn_mp_context,1);
  1876.   (void) make_module_function(stacktop,"mp-and",Fn_mp_and,3);
  1877.   (void) make_module_function(stacktop,"mp-or",Fn_mp_or,3);
  1878.   (void) make_module_function(stacktop,"mp-not",Fn_mp_not,2);
  1879.   (void) make_module_function(stacktop,"mp-assign",Fn_mp_assign,3);
  1880.   (void) make_module_function(stacktop,"mp-bin-op",Fn_mp_bin_op,4);
  1881.   (void) make_module_function(stacktop,"mp-rel-op",Fn_mp_rel_op,4);
  1882.   (void) make_module_function(stacktop,"mp-un-op",Fn_mp_un_op,3);
  1883.   (void) make_module_function(stacktop,"mp-scan-op",Fn_mp_scan_op,3);
  1884.   (void) make_module_function(stacktop,"mp-random",Fn_mp_random,1);
  1885.   (void) make_module_function(stacktop,"mp-test",Fn_mp_test,3);
  1886.   (void) make_module_function(stacktop,"mp-eq",Fn_mp_eq,3);
  1887.   (void) make_module_function(stacktop,"mp-length",Fn_mp_length,1);
  1888.   (void) make_module_function(stacktop,"mp-make-vector",Fn_mp_make_vector,2);
  1889.   (void) make_module_function(stacktop,"mp-vector-length",Fn_mp_vector_length,2);
  1890.   (void) make_module_function(stacktop,"mp-vector-ref",Fn_mp_vector_ref,3);
  1891.   (void) make_module_function(stacktop,"mp-vector-set",Fn_mp_vector_set,4);
  1892.   (void) make_module_function(stacktop,"mp-vector-merge",Fn_mp_vector_merge,3);
  1893.   (void) make_module_function(stacktop,"mp-move",Fn_mp_move,5);
  1894.   (void) make_module_function(stacktop,"mp-match",Fn_mp_match,4);
  1895.   (void) make_module_function(stacktop,"cm-put",Fn_cm_put,4);
  1896.   (void) make_module_function(stacktop,"cm-start",Fn_cm_start,1);
  1897.   (void) make_module_function(stacktop,"mp-x-stat",Fn_mp_x_stat,2);
  1898.   (void) make_module_function(stacktop,"mp-gc", Fn_mp_gc, 0);
  1899.   (void) make_module_function(stacktop,"become-strange", Fn_become_strange, 1);
  1900.   (void) make_module_function(stacktop,"mp-ps-ref", Fn_ps_ref, 0);
  1901.   (void) make_module_function(stacktop,"mp-ps-set", Fn_ps_set, 1);
  1902.   (void) make_module_function(stacktop,"mp-sb-ref", Fn_sb_ref, 0);
  1903.   (void) make_module_function(stacktop,"mp-sb-set", Fn_sb_set, 1);
  1904.   (void) make_module_function(stacktop,"mp-config", Fn_mp_config, 0);
  1905.   (void) make_module_function(stacktop,"mp-dbg-on", Fn_dbg_on, 0);
  1906.   (void) make_module_function(stacktop,"mp-dbg-off", Fn_dbg_off, 0);
  1907.   (void) make_module_function(stacktop,"mp-xnet", Fn_xnet, 3);
  1908.   (void) make_module_function(stacktop,"mp-edge",Fn_mp_edge, 2);
  1909.   
  1910.  
  1911.   fe_symbol_table = EUCALL_1(Fn_make_table,nil);
  1912.   reffed_symbols  = EUCALL_1(Fn_make_table,nil);
  1913.  
  1914.   add_root(&fe_symbol_table);
  1915.   add_root(&reffed_symbols);
  1916.  
  1917.   TREF_UPDATE(fe_symbol_table,allocate_integer(stacktop,MP_NIL_ID),nil);
  1918.   TREF_UPDATE(reffed_symbols,nil,allocate_integer(stacktop,MP_NIL_ID));
  1919.   TREF_UPDATE(fe_symbol_table,allocate_integer(stacktop,MP_T_ID),lisptrue);
  1920.   TREF_UPDATE(reffed_symbols,lisptrue,allocate_integer(stacktop,MP_T_ID));
  1921.  
  1922.   next_symbol_key = 2; 
  1923.   ListOfStrangeThings = 0;
  1924.  
  1925.   pe_scratch = (char *) CallRequest((mp_init_plural,0));
  1926.  
  1927.   copyIn( (char *) &private_nproc, (char *) &maspar_config, sizeof(int));
  1928. fprintf(stderr,"\nMasPar Configuration = %d\n", maspar_config);
  1929.   fe_scratch = malloc(maspar_config*SCRATCH_MEMORY_SIZE);
  1930.   
  1931.   close_module();
  1932. }
  1933.